home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix03.arc / COLORS.SYS < prev    next >
Text File  |  1986-08-04  |  6KB  |  194 lines
  1. (****************************************************************************)
  2. (*                                                                          *)
  3. (*                            COLORS.SYS                                    *)
  4. (*                                                                          *)
  5. (*      Sets various screen attributes.  Includes:                          *)
  6. (*                                                                          *)
  7. (*      SetCursorOn      -P-   Turns cursor on.                             *)
  8. (*      SetCursorOff     -P-   Turns cursor off.                            *)
  9. (*      IntensityOn      -P-   Sets Default Char. Intensity Bit on.         *)
  10. (*      IntensityOff     -P-   Sets Default Char. Intensity Bit off.        *)
  11. (*      UnderLineOn      -P-   Sets UnderLine Bit on.                       *)
  12. (*      UnderLineOff     -P-   Sets UnderLine Bit off.                      *)
  13. (*      BlinkOn          -P-   Sets Blink Bit On.                           *)
  14. (*      BlinkOff         -P-   Sets Blink Bit Off.                          *)
  15. (*      InverseOn        -P-   Mono: Turns on Inverse. Color: Wierd.        *)
  16. (*      InverseOff       -P-   Mono: Turns off Inverse.  Color: Wierd.      *)
  17. (*      TextForeColor    -P-   Sets Text Foreground Color Bits.             *)
  18. (*      TextBackColor    -P-   Sets Text Backround Color Bits.              *)
  19. (*      TextBorderColor  -P-   Sets Border Attribute (Color).               *)
  20. (*      MakeAttribute    -F-   Converts an Attribute_Rec to Char.           *)
  21. (*      SetColorType     -P-   Sets all Screen Attributes at once.          *)
  22. (*      ColorField       -P-   Sets Attributes of a screen field.           *)
  23. (*                                                                          *)
  24. (*                                                                          *)
  25. (*      REQUIRES:   DISPDEF.SYS                                             *)
  26. (*                  BIOS.SYS                                                *)
  27. (*                  PBIOS.SYS                                               *)
  28. (*                  DISPLAY.SYS                                             *)
  29. (*                                                                          *)
  30. (*      written by:      John Leonard    4/6/1986                           *)
  31. (*                                                                          *)
  32. (*       NOT FOR SALE WITHOUT WRITTEN PERMISSION                            *)
  33. (*                                                                          *)
  34. (****************************************************************************)
  35.  
  36. procedure SetCursorOn;
  37.    begin
  38.      with CurrentScreenData do begin
  39.         s1 :=  not ((not s1) or 32);
  40.         SetCursorSize( s1,s2);
  41.      end;
  42.    end;
  43.  
  44.  
  45. procedure SetCursorOff;
  46.    begin
  47.       with currentscreendata do begin
  48.          if ( (s1 and 32)=32) then exit;
  49.          s1 := s1 or 32;
  50.          setcursorsize(s1,s2);
  51.       end;
  52.    end;
  53.  
  54.  
  55. procedure IntensityOff;
  56.    begin
  57.       with CurrentScreenData do begin
  58.         attribute := not( (not attribute) or 8);
  59.       end;
  60.    end;
  61.  
  62.  
  63. procedure IntensityOn;
  64.    begin
  65.       with CurrentScreenData do begin
  66.          if ((attribute and $70)=$70) then exit;
  67.          if ((attribute and 8)= 8) then exit;
  68.          Attribute := attribute or 8;
  69.       end;
  70.    end;
  71.  
  72.  
  73. procedure UnderLineOn;
  74.    begin
  75.       with CurrentScreenData do begin
  76.         if ((attribute and $70)=$70) then exit;
  77.         if ( hardb = $B000) then begin
  78.            if ((attribute and 8)=8) then attribute := 9 else
  79.                attribute := 1 or (attribute and 128);
  80.            end
  81.         else
  82.            attribute := 1 or  attribute ;
  83.       end;
  84.    end;
  85.  
  86.  
  87. procedure UnderLineOff;
  88.    begin
  89.       with CurrentScreenData do begin
  90.          if ((attribute and $70)=$70) then exit;
  91.          if (hardb = $B000) then begin
  92.             if ((attribute and 8)=8) then attribute := 10 else
  93.                attribute :=  7 or (attribute and 128);
  94.             end
  95.          else
  96.             attribute := not ( not(attribute) or 1 );
  97.       end;
  98.    end;
  99.  
  100.  
  101.  
  102. procedure BlinkOn;
  103.    begin
  104.       with CurrentScreenData do begin
  105.          if  ((attribute and 128) = 128) then exit;
  106.          attribute := attribute or 128;
  107.       end;
  108.    end;
  109.  
  110.  
  111. procedure BlinkOff;
  112.    begin
  113.       with CurrentScreenData do
  114.           attribute := not((not attribute) or 128);
  115.    end;
  116.  
  117.  
  118. procedure InverseOn;
  119.    begin
  120.       with CurrentScreenData do
  121.          if (hardb=$b000) then
  122.             attribute := $70 or (attribute and 128)
  123.          else begin
  124.             if (attribute and 128)=128 then
  125.                attribute :=  not(attribute) or 128
  126.             else
  127.                attribute := not ( attribute or 128 );
  128.          end;
  129.    end;
  130.  
  131. procedure InverseOff;
  132.    begin
  133.       with CurrentScreenData do
  134.          if ( hardb=$b000) then
  135.             attribute := 10 or (attribute and 128)
  136.          else begin
  137.             if (attribute and 128)=128 then
  138.                attribute :=  not(attribute) or 128
  139.             else
  140.                attribute := not ( attribute or 128 );
  141.          end;
  142.    end;
  143.  
  144.  
  145. procedure TextForeColor( i : integer );
  146.    var j:integer;
  147.    begin
  148.       if not (i in [0..15]) then exit;
  149.       j := hi(defaultattribute);
  150.       DefaultAttribute := i or j;
  151.       CurrentScreenData.attribute := DefaultAttribute;
  152.    end;
  153.  
  154.  
  155. procedure TextBackColor ( i: integer);
  156.    var j:integer;
  157.    begin
  158.       if not (i in [0..7] ) then exit;
  159.       j := lo(defaultattribute);
  160.       Defaultattribute := (i shl 4) or j;
  161.       CurrentScreenData.attribute := DefaultAttribute;
  162.    end;
  163.  
  164.  
  165. procedure TextBorderColor ( i:integer);
  166.    begin
  167.       SetColorPalette(i);
  168.    end;
  169.  
  170.  
  171. function MakeAttribute (  scr_rec : Attribute_Rec): char ;
  172.    begin
  173.       MakeAttribute := char( (scr_rec[2] shl 4) + scr_rec[1]) ;
  174.    end;
  175.  
  176.  
  177. procedure SetColorType ( scr_rec : Attribute_Rec );
  178.    begin
  179.       TextForeColor( scr_rec[1] );
  180.       TextBackColor( scr_rec[2] );
  181.       TextBorderColor( scr_rec[3] );
  182.    end;
  183.  
  184.  
  185.  
  186. procedure colorfield( x,y,length:integer;attr:char);
  187.    var  i:integer;
  188.    begin
  189.       for i := 0 to length-1 do begin
  190.          while not ( (port[$3DA] and 8)=8 ) do;
  191.          mem[seg(displaystack[0]^):(woffset(y-1,x+i-1)+1) ] := byte(attr);
  192.       end;
  193.    end;
  194.